#############################################################
###                                                       ###
###                                                       ###
###           Visual Acuity Converter Functions           ###
###                                                       ###
###                                                       ###
#############################################################

### References ###
# Jack T. Holladay, Msee, Visual acuity measurements, Journal of Cataract & Refractive Surgery, Volume 30, Issue 2, February 2004, Pages 287-290, ISSN 0886-3350, DOI: 10.1016/j.jcrs.2004.01.014.
# (http://www.sciencedirect.com/science/article/B6VSF-4BX5RWS-2/2/c76a1a79f122eed8ace7be814131f749)


################################
#                              #
#            logmar            #
#                              #
################################

logmar <- function(x, snell.numerator = 20, inverse = FALSE) {
  if (inverse) {
    decimal <- 10 ^ (-x)
    snell.denominator <- snell.numerator/decimal
    return(snell.denominator)
  }

  decimal <- snell.numerator/x
  logMAR <- ( -log10(decimal) )
  return(logMAR)
}


## Define Function for Counting Fingers (CF) and Hand Motion (HM)

CFHM <- function(x, zero) {
  output <- vector("numeric", length(x))
  index <- grepl("[0-9]", x)

  dat <- do.call("rbind", strsplit(x = x[index], split = "[[:space:]]+"))
  dat[, 1] <- ifelse(dat[, 1] == "CF", 200, ifelse(dat[, 1] == "HM", 2000,
    "Invalid/unsupported measure of visual acuity"))
  dat <- matrix(as.numeric(dat), nrow = dim(dat)[1],
    ncol = dim(dat)[2], dimnames = list(NULL, c("denom", "numer")))

  output[index] <- logmar(dat[, "denom"], dat[, "numer"])
  output[!index] <- zero
  return(output)
}

## Define Function for calculating logMARs from Snellen Values
snellen <- function(snellenvalue, chart.values, chart.nletters) {
  output <- vector("numeric", length(snellenvalue))
  index <- grepl("\\+|\\-", snellenvalue)

  if (any(index)) {
    ## logMAR calculations including interpolating partial lines
    isv <- strsplit(x = snellenvalue[index], split = "/|[[:space:]]+")
    isv <- as.data.frame(do.call("rbind", isv), stringsAsFactors = FALSE)
    isv[,-3] <- as.data.frame(lapply(isv[,-3], as.numeric))
    colnames(isv) <- c("numer", "denom", "sign", "nletters")

    ## This block of code converts the various arguments to numeric
    ## from possibly character data. It also reorders the chart so that higher (+) line
    ## numbers indicate better vision (i.e., 20/400 would come before 20/20, not after)
    new.chart <- matrix(
      data = as.numeric(unlist(strsplit(x = chart.values, split = "/"))),
      ncol = 2, byrow = TRUE)
    new.chart <- cbind(new.chart, chart.nletters)
    colnames(new.chart) <- c("numer", "denom", "nletters")
    reordered <- order(new.chart[ , "numer"] / new.chart[ , "denom"])
    new.chart <- new.chart[reordered, ]
    location <- match(paste(isv[, "numer"], isv[, "denom"], sep = "/"),
      chart.values[reordered])

    ## Depending whether the sign is positive or negative, it either goes up
    ## or down one line for interpolation
    location2 <- ifelse(isv[, "sign"] == "+", location + 1, location - 1)
    new.nletters <- new.chart[ifelse(isv[, "sign"] == "+", location2,
      location), "nletters"]

    # If the given Snellen value is "20/30 + 3", xnum = 20, xdenom = 30
    # and ynum/denom are the values for the line being interpolated between.
    # This just standardizes the variable names so one equation can do the calculations
    xnum <- new.chart[location, "numer"]
    xdenom <- new.chart[location, "denom"]
    ynum <- new.chart[location2, "numer"]
    ydenom <- new.chart[location2, "denom"]

    names(new.nletters) <- names(xnum) <- names(xdenom) <- names(ynum) <- names(ydenom) <- NULL

    ## Go chart.nletters/new.nletters of the distance between the logMARs
    ## i.e., a linear interpolation
    output[index] <-
        logmar(x = xdenom, snell.numerator = xnum) -
        ( (logmar(x = xdenom, snell.numerator = xnum) -
           logmar(x = ydenom, snell.numerator = ynum)) *
         (isv[, "nletters"] / new.nletters)
        )
  }

  if (any(!index)) {
    ## Simple logMAR calculations for snellen values
    sv <- do.call("rbind", strsplit(x = snellenvalue[!index], split = "/"))
    sv <- matrix(as.numeric(sv), nrow = dim(sv)[1], ncol = dim(sv)[2],
      dimnames = list(NULL, c("numer", "denom")))
    output[!index] <- logmar(x = sv[, "denom"],
      snell.numerator = sv[, "numer"])
  }

  return(output)
}


################################
#                              #
#         VAConverter          #
#                              #
################################

VAConverter <- function(OS, OD, chart.values = NULL, chart.nletters = NULL,
  datatype = c("snellen", "decimal", "logMAR"), zero = 3) {

  datatype <- match.arg(datatype)

  dat <- new("VAObject", originalOS = OS, originalOD = OD,
    zero = as.numeric(zero))

  if (!missing(chart.values) && !missing(chart.nletters)) {
    dat@chart.values <- chart.values
    dat@chart.nletters <- chart.nletters
  }

  switch(datatype,
    snellen = {},
    decimal = {dat@logMAROS <- (-log10(dat@originalOS))
      dat@logMAROD <- (-log10(dat@originalOD))
      return(dat)},
    logMAR = {dat@logMAROS <- dat@originalOS
      dat@logMAROD <- dat@originalOD
      return(dat)})

  tmpOS <- dat@originalOS
  tmpOD <- dat@originalOD
  tmpOS[nchar(tmpOS) < 2] <- NA
  tmpOD[nchar(tmpOD) < 2] <- NA
  pattern <- c("/", "CF|HM", "LP|NLP|Prosthetic")
  indexOS <- sapply(pattern, grep, x = tmpOS, ignore.case = TRUE)
  indexOD <- sapply(pattern, grep, x = tmpOD, ignore.case = TRUE)

  ## To do: ignore 0 length grep results better, this is a terrible kludge
  if (length(indexOS[[1]]) > 0) {
  tmpOS[indexOS[[1]]] <- snellen(snellenvalue = tmpOS[indexOS[[1]]],
    chart.values = dat@chart.values,
    chart.nletters = dat@chart.nletters)
  }
  if (length(indexOS[[2]]) > 0) {
  tmpOS[indexOS[[2]]] <- CFHM(x = tmpOS[indexOS[[2]]], zero = zero)
  }
  if (length(indexOS[[3]]) > 0) {
  tmpOS[indexOS[[3]]] <- zero
  }

  if (length(indexOD[[1]]) > 0) {
  tmpOD[indexOD[[1]]] <- snellen(snellenvalue = tmpOD[indexOD[[1]]],
    chart.values = dat@chart.values,
    chart.nletters = dat@chart.nletters)
  }
  if (length(indexOD[[2]]) > 0) {
  tmpOD[indexOD[[2]]] <- CFHM(x = tmpOD[indexOD[[2]]], zero = zero)
  }
  if (length(indexOD[[3]]) > 0) {
  tmpOD[indexOD[[3]]] <- zero
  }

  dat@logMAROS <- as.numeric(tmpOS)
  dat@logMAROD <- as.numeric(tmpOD)

  if (isTRUE(ValidVAObject(dat))) return(dat) else stop("Malformed VAObject")
}

## sampdat <- c("HM 12", "20/20 + 3", "20/50", "CF", "HM", "20/70 - 2", "LP", NA, "Prosthetic")
## tmp <- VAConverter(OS = sampdat, OD = rev(sampdat), datatype = "snellen")



